COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	//	BOUNDARY TAG STORAGE ALLOCATOR
C00004 00003
C00005 00004
C00008 00005
C00009 ENDMK
C⊗;
//	BOUNDARY TAG STORAGE ALLOCATOR
// Copyright Xerox Corporation 1979
//
//	ZONE=INITIALIZEZONE(START, LENGTH, OUTOFSPACERTN)
//	ADDTOZONE(ZONE, START, LENGTH)
//	PTR=ALLOCATE(ZONE, SIZE)
//	FREE(ZONE, PTR)

// WARNING: A ZONE MUST NOT BE BIGGER THAN 32K-1 WORDS

GET "PUPLIB.HDR"

// ERROR CODES
MANIFEST
[
ECOUTOFSPACE		=1801
ECZONEADDITIONERROR	=1802
ECBLOCKNOTALLOCATED	=1803
ECILLFORMED		=1804
ECBADREQUEST		=1805
]

// STORAGE BLOCK
MANIFEST	//STRUCTURE SB
[
LNGTH		=0	// + FOR FREE BLOCKS, - FOR ALLOCATED ONES
DATA		=1	// ALLOCATED BLOCK: START OF DATA SPACE
PSBNEXT		=1
PSBPREVIOUS	=2
]
MANIFEST
[
LSBOVERHEAD	=1
MINLSBFREE	=3
OFFSETSBDATA	=1
]

// ZONE 
MANIFEST	//STRUCTURE ZN
[
OUTOFSPACE	=0	// NON-ZERO TO REPORT INSUFFICIENT SPACE
ANCHOR		=1
ROVER		=4 
MINADR		=5
MAXADR		=6
]
MANIFEST
[
LZN		=7
]

// ACTUALLY A ZONE IS A ZONE HEADER, FOLLOWED BY A CONSECUTIVE SEQUENCE OF
// BLOCKS FOLLOWED BY A DUMMY USED BLOCK, WHICH IS A WORD CONTAINING -1.
// THE SB IN THE HEADER ACTS AS AN ANCHOR FOR THE FREE CHAIN.

MANIFEST
[
LZNOVERHEAD=LZN+LSBOVERHEAD
]

//
LET INITIALIZEZONE(ZN, LENGTH, OUTOFSPACERTN)=VALOF
//
	[
	LET SBANCHOR=NIL
	LET FIRSTFREE=NIL
	ZN!OUTOFSPACE:=OUTOFSPACERTN
	IF ZN!OUTOFSPACE EQ 0 THEN ZN!OUTOFSPACE:=SYSERR
	SBANCHOR:=LV ZN!ANCHOR
	SBANCHOR!LNGTH:=0
	SBANCHOR!PSBNEXT:=SBANCHOR
	SBANCHOR!PSBPREVIOUS:=SBANCHOR
	FIRSTFREE:=ZN+LZN
	ZN!ROVER:=FIRSTFREE
	ADDTOZONE(ZN, FIRSTFREE,LENGTH-LZN)
	RESULTIS ZN
	]
//
AND ADDTOZONE(ZN, SB, LENGTH) BE
//
	[
	LET LSBFREE=LENGTH-LSBOVERHEAD	//ACCOUNT FOR -1 AT END
	SB!LSBFREE:=-1
	SB!LNGTH:=-LSBFREE
	FREE(ZN, SB+OFFSETSBDATA)
	]

//
AND ALLOCATE(ZN, LSBDATA)=VALOF
//
	[
	LET LSB=NIL
	LET SBROVER=NIL
	LET SBORIGINALROVER=NIL
	LET LARGEST=#100000		//MOST NEGATIVE #
IF EVEN THEN LSBDATA:=LSBDATA+1	//GET ONE MORE
	IF USC(LSBDATA, #77777) GR 0 THEN
		[
		SYSERR(ZN, ECBADREQUEST)
		]
	LSB:=LSBDATA+LSBOVERHEAD
	IF LSB LS MINLSBFREE THEN LSB:=MINLSBFREE
	SBROVER:=ZN!ROVER; SBORIGINALROVER:=SBROVER
		[
		LET SBNEXT=NIL
		LET SB=NIL
		LET EXTRA=NIL
		LET ANS=NIL
// LOOP WHILE NEXT NEIGHBOR IS FREE, COALESCING HIM WITH ROVER
			[
			SBNEXT:=SBROVER+SBROVER!LNGTH
			IF SBNEXT!LNGTH LE 0 THEN BREAK
			IF SBNEXT EQ SBORIGINALROVER THEN
				SBORIGINALROVER:=SBNEXT!PSBNEXT
// REMOVE SBNEXT FROM HIS CHAINS
			(SBNEXT!PSBNEXT)!PSBPREVIOUS:=SBNEXT!PSBPREVIOUS
			(SBNEXT!PSBPREVIOUS)!PSBNEXT:=SBNEXT!PSBNEXT
// AND ADD HIM TO US
			SBROVER!LNGTH:=SBROVER!LNGTH+SBNEXT!LNGTH
			] REPEAT
		SB:=SBNEXT-LSB
		EXTRA:=SB-SBROVER
		IF EXTRA GR LARGEST THEN LARGEST:=EXTRA
		IF EXTRA LS 0 THEN [ SBROVER:=SBROVER!PSBNEXT; LOOP ]
		TEST EXTRA GE MINLSBFREE
		 THEN
// SPLIT BLOCK
			[
			SBROVER!LNGTH:=EXTRA
			ZN!ROVER:=SBROVER
// SET THE LENGTH AND MARK THE NEW BLOCK USED
			SB!LNGTH:=-LSB
			]
		 OR
			[
// REMOVE ROVER FROM HIS CHAINS
			(SBROVER!PSBNEXT)!PSBPREVIOUS:=SBROVER!PSBPREVIOUS
			(SBROVER!PSBPREVIOUS)!PSBNEXT:=SBROVER!PSBNEXT
			ZN!ROVER:=SBROVER!PSBNEXT
// AND MARK THE NEW BLOCK USED
			SB:=SBROVER
			SB!LNGTH:=-SB!LNGTH
			]
		ANS:=SB+OFFSETSBDATA
		RESULTIS ANS
		]
	REPEATWHILE SBROVER NE SBORIGINALROVER
	ZN!ROVER:=SBROVER
	IF ZN!OUTOFSPACE EQ 0 THEN
		[
		RESULTIS 0
		]
	RESULTIS ZN!OUTOFSPACE(ZN, ECOUTOFSPACE, LSBDATA)
	]

//
AND FREE(ZN, SB) BE
//
	[
// THIS CAN BE CALLED WITH THE RESULT OF A CALL TO ALLOCATE ROUNDED UP BY
// ANYTHING FROM 0 TO 1 (IF EVEN)
	LET SBANCHOR=NIL
	LET SBT=NIL
	IF SB!-1 EQ 0 THEN SB:=SB-1	//WAS EVEN ALLOCATION
	SB:=(SB-OFFSETSBDATA)
	SBANCHOR:=LV ZN!ANCHOR
// MARK THE BLOCK FREE
	SB!LNGTH:=-SB!LNGTH
	SBT:=SBANCHOR!PSBNEXT
	SB!PSBPREVIOUS:=SBANCHOR; SB!PSBNEXT:=SBT
	SBANCHOR!PSBNEXT:=SB; SBT!PSBPREVIOUS:=SB
	]